Charlie Veniot 25th October 2022 at 8:01pm
' Easy spiral
' A QBJS program by bplus (found at https://qb64.boards.net/thread/27/bplus-collection)
' Altered to work in BAM by Charlie Veniot (comments marked with "➡")
' ➡ BAM requires subroutine declaration before any reference to it
DECLARE SUB fcirc (CX As Long, CY As Long, R As Long, C As Long)
' ➡ Program works better in BAM using screen 19
Screen _NewImage(700, 700, 19)
Dim tick, s, c, h, x, y, lastX, lastY
s = 7
Do
Cls
For c = 1 To 2000
h = c + tick
x = Sin(6 * h / _Pi) + Sin(3 * h)
h = c + tick * 2
y = Cos(6 * h / _Pi) + Cos(3 * h)
fcirc s * (20 * x + 50), s * (20 * y + 50), 2, _RGB32(255, 255, 255)
Next
_Display
_Limit 120
tick = tick + .001
Loop
' ➡ C datatype changed to Long (BAM does not have unsigned long)
Sub fcirc (CX As Long, CY As Long, R As Long, C As Long) ' SMcNeill's fill circle
Dim subRadius As Long, RadiusError As Long, X As Long, Y As Long
subRadius = Abs(R): RadiusError = -subRadius: X = subRadius: Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C
Line (CX - Y, CY + X)-(CX + Y, CY + X), C
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C
Line (CX - X, CY + Y)-(CX + X, CY + Y), C
Wend
End Sub